home *** CD-ROM | disk | FTP | other *** search
/ Amiga Plus 1995 #5 & #6 / Amiga Plus CD - 1995 - No. 5 and 6.iso / pd / serien / purity / nr.15 / kickpascal-programme / gbu / gbu2.p < prev    next >
Text File  |  1995-04-22  |  4KB  |  136 lines
  1.  
  2.  
  3. {**********************************************************************
  4.  gbu.p © 10.05.93 by Røgersøft
  5.  
  6.                      Michael Klein
  7.                      Am Wasserturm 6,
  8.                      67346 Speyer   ( ab 1.7.93 )
  9.  
  10.  Programmiert für PURITY der FD-Reihe für Pascaluser.
  11.  Das Programm dürft Ihr in eigenen Programmen benutzen, solange
  12.  diese nicht kommerziell oder militärisch genutzt werden. Außerdem
  13.  muß dieses Programm dann auf einer Diskette der Purity-Reihe ver-
  14.  öffentlicht werden.
  15.  
  16. ************************************************************************}
  17.  
  18. PROGRAM gbudemo;  { V0.01 }
  19.  
  20.  
  21. USES Intuition;
  22.  
  23. TYPE strtyp=STRING;
  24.  
  25. VAR win:p_window;
  26.     MessagePtr1: p_IntuiMessage;
  27.     aktgad:p_gadget;
  28.     toggler,ende:BOOLEAN;
  29.     ok:LONG;
  30.     gad: GADGET;
  31.     it1:Intuitext;
  32.  
  33. {********************************************************************}
  34.  
  35. PROCEDURE umrandung(wo:p_window,c1,c2,x,y,b,h:INTEGER);
  36.  
  37.  TYPE umrandungstyp=ARRAY[0..9] OF INTEGER;
  38.  VAR Feld1,feld2:umrandungstyp;
  39.      border1,border2:BORDER;
  40.  
  41.  BEGIN
  42.   feld1:=umrandungstyp(1,1,1,h-2,0,h-1,0,0,b-2,0);
  43.   feld2:=umrandungstyp(b-2,h-2,b-2,1,b-1,0,b-1,h-1,1,h-1);
  44.   Border1:=Border(x,y,c1,0,0,5,^Feld1,^Border2);
  45.   Border2:=Border(x,y,c2,0,0,5,^Feld2,Nil);
  46.   drawborder(wo^.rport,^Border1,0,0);
  47.  END;
  48.  
  49. {********************************************************************}
  50.  
  51. PROCEDURE zeichnetext(c1,c2:SHORT,wo:p_window,x,y:INTEGER,text:strtyp);
  52.  VAR it1,it2:INTUITEXT;STATIC;
  53.  BEGIN
  54.   it1:=INTUITEXT(c1,0,JAM2,1,1,NIL,text,^it2);
  55.   it2:=INTUITEXT(c2,0,0,0,0,NIL,text,NIL );
  56.   PRINTITEXT(wo^.rport,^it1,x,y);
  57.  END;
  58.  
  59. {********************************************************************}
  60.  
  61. PROCEDURE gbu(wo:p_window,was:p_gadget,c:CHAR);
  62.  VAR  it:intuitext;STATIC;
  63.       x,y:LONG;STATIC;
  64.       stelle:INTEGER;
  65.       ok:BOOLEAN;
  66.  
  67.  BEGIN
  68.   umrandung(wo,2,1,was^.Leftedge,was^.Topedge,was^.Width,was^.height);
  69.   IF (was^.Gadgettext<>NIL) THEN
  70.   BEGIN
  71.    stelle:=POS(c,was^.gadgettext^.itext);
  72.    If stelle>0 THEN
  73.    BEGIN
  74.     stelle:=stelle-1;
  75.     x:=was^.Gadgettext^.leftedge+was^.Leftedge+8*stelle;
  76.     y:=was^.Gadgettext^.topedge+was^.Topedge+1;
  77.     it:=INTUITEXT(1,0,0,0,0,NIL,'_',NIL );
  78.     PRINTITEXT(wo^.rport,^it,x,y);
  79.    END;
  80.   END;
  81.  END;  { OF PROCEDURE gbu }
  82.  
  83. {**********************      Hauptprogramm     **************************}
  84.  
  85. BEGIN
  86.  ende:=FALSE;
  87.  Win:=Open_Window(50,50,392,45,1,_CLOSEWINDOW+GADGETUP+GADGETDOWN+Vanillakey,
  88.       WINDOWDRAG+WINDOWDEPTH+WINDOWCLOSE+ACTIVATE,
  89.       'gbuDemo V0.01 © 10.05.93 by Røgersøft',NIL,50,50,640,256);
  90.                                            { Vanillakeyflag nicht vergessen}
  91.  
  92.  it1:=INTUITEXT(1,0,0,140,3,NIL,'Klick mich !',NIL);
  93.  gad:=Gadget(NIL,20,12,352,14,GADGHCOMP,RELVERIFY,$0001,
  94.              NIL,NIL,^it1,0,NIL,1,NIL);
  95.  
  96.  gbu(win,^gad,'i'); { THE magic PROCEDURE !!! } {umrandung+"i" unterstreichen}
  97.  
  98.  ok:=ADDGADGET(win,^gad,0);
  99.  
  100.  REFRESHGADGETS(Win^.firstgadget,Win,NIL);
  101.  REPEAT
  102.   MessagePtr1:=p_Intuimessage(Waitport(Win^.Userport));
  103.   MessagePtr1:=p_Intuimessage(GetMsg(Win^.Userport));
  104.   CASE MessagePtr1^.class OF
  105.    _CLOSEWINDOW: ende:=TRUE;
  106.    GADGETUP,GADGETDOWN:
  107.     BEGIN
  108.      aktgad:=messageptr1^.iaddress;
  109.      CASE aktgad^.gadgetID OF
  110.       1: BEGIN
  111.           IF TOGGLER THEN zeichnetext(1,2,win,150,30,'Alles klar ???')
  112.                      ELSE zeichnetext(1,3,win,150,30,'Alles klar ???');
  113.           TOGGLER:=NOT TOGGLER;
  114.          END;
  115.       OTHERWISE;
  116.      END;
  117.     END; {OF Gadgetup/Gadgetdown}
  118.  
  119.    VANILLAKEY:
  120.     CASE messageptr1^.code OF
  121.      105:BEGIN               { i }
  122.           IF TOGGLER THEN zeichnetext(1,2,win,150,30,'Alles klar ???')
  123.                      ELSE zeichnetext(1,3,win,150,30,'Alles klar ???');
  124.           TOGGLER:=NOT TOGGLER;
  125.          END
  126.      27,81,113: ende:=TRUE; { ESC,q,Q }
  127.      OTHERWISE;
  128.     END;  { OF Vanillakey }
  129.  
  130.    OTHERWISE;
  131.   END;             {OF CASE}
  132.   ReplyMsg(p_Message(MessagePtr1));
  133.  UNTIL ende;
  134.  Closewindow(Win);
  135. END.
  136.